home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / lisp / trace.el < prev    next >
Lisp/Scheme  |  1993-05-17  |  11KB  |  322 lines

  1. ;;; trace.el --- tracing facility for Emacs Lisp functions
  2.  
  3. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
  6. ;; Created: 15 Dec 1992
  7. ;; Version: trace.el,v 2.0 1993/05/18 00:41:16 hans Exp
  8. ;; Keywords: tracing, debugging
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. ;; LCD Archive Entry:
  27. ;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
  28. ;; Tracing facility for Emacs Lisp functions|
  29. ;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
  30.  
  31.  
  32. ;;; Commentary:
  33.  
  34. ;; Introduction:
  35. ;; =============
  36. ;; A simple trace package that utilizes advice.el. It generates trace 
  37. ;; information in a Lisp-style fashion and inserts it into a trace output
  38. ;; buffer. Tracing can be done in the background (or silently) so that
  39. ;; generation of trace output won't interfere with what you are currently
  40. ;; doing.
  41.  
  42. ;; How to get the latest trace.el:
  43. ;; ===============================
  44. ;; You can get the latest version of this file either via anonymous ftp from 
  45. ;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
  46. ;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
  47.  
  48. ;; Requirement:
  49. ;; ============
  50. ;; trace.el needs advice.el version 2.0 or later which you can get from the
  51. ;; same place from where you got trace.el.
  52.  
  53. ;; Restrictions:
  54. ;; =============
  55. ;; - Traced subrs when called interactively will always show nil as the
  56. ;;   value of their arguments.
  57. ;; - Only functions/macros/subrs that are called via their function cell will
  58. ;;   generate trace output, hence, you won't get trace output for:
  59. ;;   + Subrs called directly from other subrs/C-code
  60. ;;   + Compiled calls to subrs that have special byte-codes associated
  61. ;;     with them (e.g., car, cdr, ...)
  62. ;;   + Macros that were expanded during compilation
  63. ;; - All the restrictions that apply to advice.el
  64.  
  65. ;; Installation:
  66. ;; =============
  67. ;; Put this file together with advice.el (version 2.0 or later) somewhere
  68. ;; into your Emacs `load-path', byte-compile it/them for efficiency, and
  69. ;; put the following autoload declarations into your .emacs
  70. ;;
  71. ;;    (autoload 'trace-function "trace" "Trace a function" t)
  72. ;;    (autoload 'trace-function-background "trace" "Trace a function" t)
  73. ;;
  74. ;; or explicitly load it with (require 'trace) or (load "trace").
  75.  
  76. ;; Comments, suggestions, bug reports
  77. ;; ==================================
  78. ;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
  79.  
  80. ;; Usage:
  81. ;; ======
  82. ;; - To trace a function say `M-x trace-function' which will ask you for the
  83. ;;   name of the function/subr/macro to trace, as well as for the buffer
  84. ;;   into which trace output should go.
  85. ;; - If you want to trace a function that switches buffers or does other
  86. ;;   display oriented stuff use `M-x trace-function-background' which will
  87. ;;   generate the trace output silently in the background without popping
  88. ;;   up windows and doing other irritating stuff.
  89. ;; - To untrace a function say `M-x untrace-function'.
  90. ;; - To untrace all currently traced functions say `M-x untrace-all'.
  91.  
  92. ;; Examples:
  93. ;; =========
  94. ;;
  95. ;;  (defun fact (n)
  96. ;;    (if (= n 0) 1
  97. ;;      (* n (fact (1- n)))))
  98. ;;  fact
  99. ;;  
  100. ;;  (trace-function 'fact)
  101. ;;  fact
  102. ;;
  103. ;;  Now, evaluating this...
  104. ;;
  105. ;;  (fact 4)
  106. ;;  24
  107. ;;
  108. ;;  ...will generate the following in *trace-buffer*:
  109. ;;
  110. ;;  1 -> fact: n=4
  111. ;;  | 2 -> fact: n=3
  112. ;;  | | 3 -> fact: n=2
  113. ;;  | | | 4 -> fact: n=1
  114. ;;  | | | | 5 -> fact: n=0
  115. ;;  | | | | 5 <- fact: 1
  116. ;;  | | | 4 <- fact: 1
  117. ;;  | | 3 <- fact: 2
  118. ;;  | 2 <- fact: 6
  119. ;;  1 <- fact: 24
  120. ;;
  121. ;;
  122. ;;  (defun ack (x y z)
  123. ;;    (if (= x 0) 
  124. ;;        (+ y z)
  125. ;;      (if (and (<= x 2) (= z 0)) 
  126. ;;          (1- x)
  127. ;;        (if (and (> x 2) (= z 0)) 
  128. ;;            y
  129. ;;          (ack (1- x) y (ack x y (1- z)))))))
  130. ;;  ack
  131. ;;
  132. ;;  (trace-function 'ack)
  133. ;;  ack
  134. ;;
  135. ;;  Try this for some interesting trace output:
  136. ;;
  137. ;;  (ack 3 3 1)
  138. ;;  27
  139. ;;
  140. ;; 
  141. ;; The following does something similar to the functionality of the package
  142. ;; log-message.el by Robert Potter, which is giving you a chance to look at
  143. ;; messages that might have whizzed by too quickly (you won't see subr
  144. ;; generated messages though):
  145. ;;
  146. ;; (trace-function-background 'message "*Message Log*")
  147.  
  148.  
  149. ;;; Change Log:
  150.  
  151. ;; Revision 2.0 1993/05/18 00:41:16 hans
  152. ;;    * Adapted for advice.el 2.0; it now also works
  153. ;;      for GNU Emacs-19 and Lemacs
  154. ;;    * Separate function `trace-function-background'
  155. ;;    * Separate pieces of advice for foreground and background tracing
  156. ;;    * Less insane handling of interactive trace buffer specification
  157. ;;    * String arguments and values are now printed properly
  158. ;;
  159. ;; Revision 1.1 1992/12/15 22:45:15 hans
  160. ;;    * Created, first public release
  161.  
  162.  
  163. ;;; Code:
  164.  
  165. (require 'advice)
  166.  
  167. ;; For the odd case that ``' does not have an autoload definition in some
  168. ;; Emacs we autoload it here. It is only needed for compilation, hence,
  169. ;; I don't want to unconditionally `require' it:
  170. (if (not (fboundp '`)) (autoload '` "backquote"))
  171.  
  172. (defconst trace-version "2.0")
  173.  
  174. ;;;###autoload
  175. (defvar trace-buffer "*trace-output*"
  176.   "*Trace output will by default go to that buffer.")
  177.  
  178. ;; Current level of traced function invocation:
  179. (defvar trace-level 0)
  180.  
  181. ;; Semi-cryptic name used for a piece of trace advice:
  182. (defvar trace-advice-name 'trace-function\ )
  183.  
  184. ;; Used to separate new trace output from previous traced runs:
  185. (defvar trace-separator (format "%s\n" (make-string 70 ?=)))
  186.  
  187. (defun trace-entry-message (function level argument-bindings)
  188.   ;; Generates a string that describes that FUNCTION has been entered at
  189.   ;; trace LEVEL with ARGUMENT-BINDINGS.
  190.   (format "%s%s%d -> %s: %s\n"
  191.       (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
  192.       (if (> level 1) " " "")
  193.       level
  194.       function
  195.       (mapconcat (function
  196.               (lambda (binding)
  197.             (concat
  198.              (symbol-name (ad-arg-binding-field binding 'name))
  199.              "="
  200.              ;; do this so we'll see strings:
  201.              (prin1-to-string
  202.               (ad-arg-binding-field binding 'value)))))
  203.              argument-bindings
  204.              " ")))
  205.  
  206. (defun trace-exit-message (function level value)
  207.   ;; Generates a string that describes that FUNCTION has been exited at
  208.   ;; trace LEVEL and that it returned VALUE.
  209.   (format "%s%s%d <- %s: %s\n"
  210.       (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
  211.       (if (> level 1) " " "")
  212.       level
  213.       function
  214.       ;; do this so we'll see strings:
  215.       (prin1-to-string value)))
  216.  
  217. (defun trace-make-advice (function buffer background)
  218.   ;; Builds the piece of advice to be added to FUNCTION's advice info
  219.   ;; so that it will generate the proper trace output in BUFFER
  220.   ;; (quietly if BACKGROUND is t).
  221.   (ad-make-advice
  222.    trace-advice-name nil t
  223.    (cond (background
  224.       (` (advice
  225.           lambda ()
  226.           (let ((trace-level (1+ trace-level))
  227.             (trace-buffer (get-buffer-create (, buffer))))
  228.         (save-excursion
  229.           (set-buffer trace-buffer)
  230.           (goto-char (point-max))
  231.           ;; Insert a separator from previous trace output:
  232.           (if (= trace-level 1) (insert trace-separator))
  233.           (insert
  234.            (trace-entry-message
  235.             '(, function) trace-level ad-arg-bindings)))
  236.         ad-do-it
  237.         (save-excursion
  238.           (set-buffer trace-buffer)
  239.           (goto-char (point-max))
  240.           (insert
  241.            (trace-exit-message
  242.             '(, function) trace-level ad-return-value)))))))
  243.      (t (` (advice
  244.         lambda ()
  245.         (let ((trace-level (1+ trace-level))
  246.               (trace-buffer (get-buffer-create (, buffer))))
  247.           (pop-to-buffer trace-buffer)
  248.           (goto-char (point-max))
  249.           ;; Insert a separator from previous trace output:
  250.           (if (= trace-level 1) (insert trace-separator))
  251.           (insert
  252.            (trace-entry-message
  253.             '(, function) trace-level ad-arg-bindings))
  254.           ad-do-it
  255.           (pop-to-buffer trace-buffer)
  256.           (goto-char (point-max))
  257.           (insert
  258.            (trace-exit-message
  259.             '(, function) trace-level ad-return-value)))))))))
  260.  
  261. (defun trace-function-internal (function buffer background)
  262.   ;; Adds trace advice for FUNCTION and activates it.
  263.   (ad-add-advice
  264.    function
  265.    (trace-make-advice function (or buffer trace-buffer) background)
  266.    'around 'last)
  267.   (ad-activate function nil))
  268.  
  269. (defun trace-is-traced (function)
  270.   (ad-find-advice function 'around trace-advice-name))
  271.  
  272. ;;;###autoload
  273. (defun trace-function (function &optional buffer)
  274.   "Traces FUNCTION with trace output going to BUFFER.
  275. For every call of FUNCTION Lisp-style trace messages that display argument
  276. and return values will be inserted into BUFFER. This function generates the
  277. trace advice for FUNCTION and activates it together with any other advice
  278. there might be!! The trace BUFFER will popup whenever FUNCTION is called.
  279. Do not use this to trace functions that switch buffers or do any other
  280. display oriented stuff, use `trace-function-background' instead."
  281.   (interactive
  282.    (list
  283.     (intern (completing-read "Trace function: " obarray 'fboundp t))
  284.     (read-buffer "Output to buffer: " trace-buffer)))
  285.   (trace-function-internal function buffer nil))
  286.  
  287. ;;;###autoload
  288. (defun trace-function-background (function &optional buffer)
  289.   "Traces FUNCTION with trace output going quietly to BUFFER.
  290. For every call of FUNCTION Lisp-style trace messages that display argument
  291. and return values will be inserted into BUFFER. This function generates the
  292. trace advice for FUNCTION and activates it together with any other advice
  293. there might be!! Trace output will quietly go to BUFFER without changing
  294. the window or buffer configuration at all."
  295.   (interactive
  296.    (list
  297.     (intern
  298.      (completing-read "Trace function in background: " obarray 'fboundp t))
  299.     (read-buffer "Output to buffer: " trace-buffer)))
  300.   (trace-function-internal function buffer t))
  301.  
  302. (defun untrace-function (function)
  303.   "Untraces FUNCTION and possibly activates all remaining advice.
  304. Activation is performed with `ad-update', hence remaining advice will get
  305. activated only if the advice of FUNCTION is currently active. If FUNCTION
  306. was not traced this is a noop."
  307.   (interactive
  308.    (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
  309.   (cond ((trace-is-traced function)
  310.      (ad-remove-advice function 'around trace-advice-name)
  311.      (ad-update function))))
  312.  
  313. (defun untrace-all ()
  314.   "Untraces all currently traced functions."
  315.   (interactive)
  316.   (ad-do-advised-functions (function)
  317.     (untrace-function function)))
  318.  
  319. (provide 'trace)
  320.  
  321. ;;; trace.el ends here
  322.